home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 44 / PC Actual CD 44.iso / Linux / Cygwin / full.exe / Disk1 / data1.cab / Tools / share / tk8.0 / button.tcl < prev    next >
Encoding:
Text File  |  1998-12-04  |  11.0 KB  |  466 lines
  1. # button.tcl --
  2. #
  3. # This file defines the default bindings for Tk label, button,
  4. # checkbutton, and radiobutton widgets and provides procedures
  5. # that help in implementing those bindings.
  6. #
  7. # SCCS: @(#) button.tcl 1.22 96/11/14 14:49:11
  8. #
  9. # Copyright (c) 1992-1994 The Regents of the University of California.
  10. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15.  
  16. #-------------------------------------------------------------------------
  17. # The code below creates the default class bindings for buttons.
  18. #-------------------------------------------------------------------------
  19.  
  20. if {$tcl_platform(platform) == "macintosh"} {
  21.     bind Radiobutton <Enter> {
  22.     tkButtonEnter %W
  23.     }
  24.     bind Radiobutton <1> {
  25.     tkButtonDown %W
  26.     }
  27.     bind Radiobutton <ButtonRelease-1> {
  28.     tkButtonUp %W
  29.     }
  30.     bind Checkbutton <Enter> {
  31.     tkButtonEnter %W
  32.     }
  33.     bind Checkbutton <1> {
  34.     tkButtonDown %W
  35.     }
  36.     bind Checkbutton <ButtonRelease-1> {
  37.     tkButtonUp %W
  38.     }
  39. }
  40. if {$tcl_platform(platform) == "windows"} {
  41.     bind Button <Return> {
  42.     tkButtonInvoke %W
  43.     }
  44.     bind Checkbutton <Return> {
  45.     tkCheckRadioInvoke %W
  46.     }
  47.     bind Radiobutton <Return> {
  48.     tkCheckRadioInvoke %W
  49.     }
  50.     bind Checkbutton <equal> {
  51.     tkCheckRadioInvoke %W select
  52.     }
  53.     bind Checkbutton <plus> {
  54.     tkCheckRadioInvoke %W select
  55.     }
  56.     bind Checkbutton <minus> {
  57.     tkCheckRadioInvoke %W deselect
  58.     }
  59.     bind Checkbutton <1> {
  60.     tkCheckRadioDown %W
  61.     }
  62.     bind Checkbutton <ButtonRelease-1> {
  63.     tkButtonUp %W
  64.     }
  65.     bind Checkbutton <Enter> {
  66.     tkCheckRadioEnter %W
  67.     }
  68.  
  69.     bind Radiobutton <1> {
  70.     tkCheckRadioDown %W
  71.     }
  72.     bind Radiobutton <ButtonRelease-1> {
  73.     tkButtonUp %W
  74.     }
  75.     bind Radiobutton <Enter> {
  76.     tkCheckRadioEnter %W
  77.     }
  78. }
  79. if {$tcl_platform(platform) == "unix"} {
  80.     bind Checkbutton <Return> {
  81.     if !$tk_strictMotif {
  82.         tkCheckRadioInvoke %W
  83.     }
  84.     }
  85.     bind Radiobutton <Return> {
  86.     if !$tk_strictMotif {
  87.         tkCheckRadioInvoke %W
  88.     }
  89.     }
  90.     bind Checkbutton <1> {
  91.     tkCheckRadioInvoke %W
  92.     }
  93.     bind Radiobutton <1> {
  94.     tkCheckRadioInvoke %W
  95.     }
  96.     bind Checkbutton <Enter> {
  97.     tkButtonEnter %W
  98.     }
  99.     bind Radiobutton <Enter> {
  100.     tkButtonEnter %W
  101.     }
  102. }
  103.  
  104. bind Button <space> {
  105.     tkButtonInvoke %W
  106. }
  107. bind Checkbutton <space> {
  108.     tkCheckRadioInvoke %W
  109. }
  110. bind Radiobutton <space> {
  111.     tkCheckRadioInvoke %W
  112. }
  113.  
  114. bind Button <FocusIn> {}
  115. bind Button <Enter> {
  116.     tkButtonEnter %W
  117. }
  118. bind Button <Leave> {
  119.     tkButtonLeave %W
  120. }
  121. bind Button <1> {
  122.     tkButtonDown %W
  123. }
  124. bind Button <ButtonRelease-1> {
  125.     tkButtonUp %W
  126. }
  127.  
  128. bind Checkbutton <FocusIn> {}
  129. bind Checkbutton <Leave> {
  130.     tkButtonLeave %W
  131. }
  132.  
  133. bind Radiobutton <FocusIn> {}
  134. bind Radiobutton <Leave> {
  135.     tkButtonLeave %W
  136. }
  137.  
  138. if {$tcl_platform(platform) == "windows"} {
  139.  
  140. #########################
  141. # Windows implementation 
  142. #########################
  143.  
  144. # tkButtonEnter --
  145. # The procedure below is invoked when the mouse pointer enters a
  146. # button widget.  It records the button we're in and changes the
  147. # state of the button to active unless the button is disabled.
  148. #
  149. # Arguments:
  150. # w -        The name of the widget.
  151.  
  152. proc tkButtonEnter w {
  153.     global tkPriv
  154.     if {[$w cget -state] != "disabled"} {
  155.     if {$tkPriv(buttonWindow) == $w} {
  156.         $w configure -state active -relief sunken
  157.     }
  158.     }
  159.     set tkPriv(window) $w
  160. }
  161.  
  162. # tkButtonLeave --
  163. # The procedure below is invoked when the mouse pointer leaves a
  164. # button widget.  It changes the state of the button back to
  165. # inactive.  If we're leaving the button window with a mouse button
  166. # pressed (tkPriv(buttonWindow) == $w), restore the relief of the
  167. # button too.
  168. #
  169. # Arguments:
  170. # w -        The name of the widget.
  171.  
  172. proc tkButtonLeave w {
  173.     global tkPriv
  174.     if {[$w cget -state] != "disabled"} {
  175.     $w config -state normal
  176.     }
  177.     if {$w == $tkPriv(buttonWindow)} {
  178.     $w configure -relief $tkPriv(relief)
  179.     }
  180.     set tkPriv(window) ""
  181. }
  182.  
  183. # tkCheckRadioEnter --
  184. # The procedure below is invoked when the mouse pointer enters a
  185. # checkbutton or radiobutton widget.  It records the button we're in
  186. # and changes the state of the button to active unless the button is
  187. # disabled.
  188. #
  189. # Arguments:
  190. # w -        The name of the widget.
  191.  
  192. proc tkCheckRadioEnter w {
  193.     global tkPriv
  194.     if {[$w cget -state] != "disabled"} {
  195.     if {$tkPriv(buttonWindow) == $w} {
  196.         $w configure -state active
  197.     }
  198.     }
  199.     set tkPriv(window) $w
  200. }
  201.  
  202. # tkButtonDown --
  203. # The procedure below is invoked when the mouse button is pressed in
  204. # a button widget.  It records the fact that the mouse is in the button,
  205. # saves the button's relief so it can be restored later, and changes
  206. # the relief to sunken.
  207. #
  208. # Arguments:
  209. # w -        The name of the widget.
  210.  
  211. proc tkButtonDown w {
  212.     global tkPriv
  213.     set tkPriv(relief) [lindex [$w conf -relief] 4]
  214.     if {[$w cget -state] != "disabled"} {
  215.     set tkPriv(buttonWindow) $w
  216.     $w config -relief sunken -state active
  217.     }
  218. }
  219.  
  220. # tkCheckRadioDown --
  221. # The procedure below is invoked when the mouse button is pressed in
  222. # a button widget.  It records the fact that the mouse is in the button,
  223. # saves the button's relief so it can be restored later, and changes
  224. # the relief to sunken.
  225. #
  226. # Arguments:
  227. # w -        The name of the widget.
  228.  
  229. proc tkCheckRadioDown w {
  230.     global tkPriv
  231.     set tkPriv(relief) [lindex [$w conf -relief] 4]
  232.     if {[$w cget -state] != "disabled"} {
  233.     set tkPriv(buttonWindow) $w
  234.     $w config -state active
  235.     }
  236. }
  237.  
  238. # tkButtonUp --
  239. # The procedure below is invoked when the mouse button is released
  240. # in a button widget.  It restores the button's relief and invokes
  241. # the command as long as the mouse hasn't left the button.
  242. #
  243. # Arguments:
  244. # w -        The name of the widget.
  245.  
  246. proc tkButtonUp w {
  247.     global tkPriv
  248.     if {$w == $tkPriv(buttonWindow)} {
  249.     set tkPriv(buttonWindow) ""
  250.     if {($w == $tkPriv(window))
  251.         && ([$w cget -state] != "disabled")} {
  252.         $w config -relief $tkPriv(relief) -state normal
  253.         uplevel #0 [list $w invoke]
  254.     }
  255.     }
  256. }
  257.  
  258. }
  259.  
  260. if {$tcl_platform(platform) == "unix"} {
  261.  
  262. #####################
  263. # Unix implementation
  264. #####################
  265.  
  266. # tkButtonEnter --
  267. # The procedure below is invoked when the mouse pointer enters a
  268. # button widget.  It records the button we're in and changes the
  269. # state of the button to active unless the button is disabled.
  270. #
  271. # Arguments:
  272. # w -        The name of the widget.
  273.  
  274. proc tkButtonEnter {w} {
  275.     global tkPriv
  276.     if {[$w cget -state] != "disabled"} {
  277.     $w config -state active
  278.     if {$tkPriv(buttonWindow) == $w} {
  279.         $w configure -state active -relief sunken
  280.     }
  281.     }
  282.     set tkPriv(window) $w
  283. }
  284.  
  285. # tkButtonLeave --
  286. # The procedure below is invoked when the mouse pointer leaves a
  287. # button widget.  It changes the state of the button back to
  288. # inactive.  If we're leaving the button window with a mouse button
  289. # pressed (tkPriv(buttonWindow) == $w), restore the relief of the
  290. # button too.
  291. #
  292. # Arguments:
  293. # w -        The name of the widget.
  294.  
  295. proc tkButtonLeave w {
  296.     global tkPriv
  297.     if {[$w cget -state] != "disabled"} {
  298.     $w config -state normal
  299.     }
  300.     if {$w == $tkPriv(buttonWindow)} {
  301.     $w configure -relief $tkPriv(relief)
  302.     }
  303.     set tkPriv(window) ""
  304. }
  305.  
  306. # tkButtonDown --
  307. # The procedure below is invoked when the mouse button is pressed in
  308. # a button widget.  It records the fact that the mouse is in the button,
  309. # saves the button's relief so it can be restored later, and changes
  310. # the relief to sunken.
  311. #
  312. # Arguments:
  313. # w -        The name of the widget.
  314.  
  315. proc tkButtonDown w {
  316.     global tkPriv
  317.     set tkPriv(relief) [lindex [$w config -relief] 4]
  318.     if {[$w cget -state] != "disabled"} {
  319.     set tkPriv(buttonWindow) $w
  320.     $w config -relief sunken
  321.     }
  322. }
  323.  
  324. # tkButtonUp --
  325. # The procedure below is invoked when the mouse button is released
  326. # in a button widget.  It restores the button's relief and invokes
  327. # the command as long as the mouse hasn't left the button.
  328. #
  329. # Arguments:
  330. # w -        The name of the widget.
  331.  
  332. proc tkButtonUp w {
  333.     global tkPriv
  334.     if {$w == $tkPriv(buttonWindow)} {
  335.     set tkPriv(buttonWindow) ""
  336.     $w config -relief $tkPriv(relief)
  337.     if {($w == $tkPriv(window))
  338.         && ([$w cget -state] != "disabled")} {
  339.         uplevel #0 [list $w invoke]
  340.     }
  341.     }
  342. }
  343.  
  344. }
  345.  
  346. if {$tcl_platform(platform) == "macintosh"} {
  347.  
  348. ####################
  349. # Mac implementation
  350. ####################
  351.  
  352. # tkButtonEnter --
  353. # The procedure below is invoked when the mouse pointer enters a
  354. # button widget.  It records the button we're in and changes the
  355. # state of the button to active unless the button is disabled.
  356. #
  357. # Arguments:
  358. # w -        The name of the widget.
  359.  
  360. proc tkButtonEnter {w} {
  361.     global tkPriv
  362.     if {[$w cget -state] != "disabled"} {
  363.     if {$tkPriv(buttonWindow) == $w} {
  364.         $w configure -state active
  365.     }
  366.     }
  367.     set tkPriv(window) $w
  368. }
  369.  
  370. # tkButtonLeave --
  371. # The procedure below is invoked when the mouse pointer leaves a
  372. # button widget.  It changes the state of the button back to
  373. # inactive.  If we're leaving the button window with a mouse button
  374. # pressed (tkPriv(buttonWindow) == $w), restore the relief of the
  375. # button too.
  376. #
  377. # Arguments:
  378. # w -        The name of the widget.
  379.  
  380. proc tkButtonLeave w {
  381.     global tkPriv
  382.     if {$w == $tkPriv(buttonWindow)} {
  383.     $w configure -state normal
  384.     }
  385.     set tkPriv(window) ""
  386. }
  387.  
  388. # tkButtonDown --
  389. # The procedure below is invoked when the mouse button is pressed in
  390. # a button widget.  It records the fact that the mouse is in the button,
  391. # saves the button's relief so it can be restored later, and changes
  392. # the relief to sunken.
  393. #
  394. # Arguments:
  395. # w -        The name of the widget.
  396.  
  397. proc tkButtonDown w {
  398.     global tkPriv
  399.     if {[$w cget -state] != "disabled"} {
  400.     set tkPriv(buttonWindow) $w
  401.     $w config -state active
  402.     }
  403. }
  404.  
  405. # tkButtonUp --
  406. # The procedure below is invoked when the mouse button is released
  407. # in a button widget.  It restores the button's relief and invokes
  408. # the command as long as the mouse hasn't left the button.
  409. #
  410. # Arguments:
  411. # w -        The name of the widget.
  412.  
  413. proc tkButtonUp w {
  414.     global tkPriv
  415.     if {$w == $tkPriv(buttonWindow)} {
  416.     $w config -state normal
  417.     set tkPriv(buttonWindow) ""
  418.     if {($w == $tkPriv(window))
  419.         && ([$w cget -state] != "disabled")} {
  420.         uplevel #0 [list $w invoke]
  421.     }
  422.     }
  423. }
  424.  
  425. }
  426.  
  427. ##################
  428. # Shared routines
  429. ##################
  430.  
  431. # tkButtonInvoke --
  432. # The procedure below is called when a button is invoked through
  433. # the keyboard.  It simulate a press of the button via the mouse.
  434. #
  435. # Arguments:
  436. # w -        The name of the widget.
  437.  
  438. proc tkButtonInvoke w {
  439.     if {[$w cget -state] != "disabled"} {
  440.     set oldRelief [$w cget -relief]
  441.     set oldState [$w cget -state]
  442.     $w configure -state active -relief sunken
  443.     update idletasks
  444.     after 100
  445.     $w configure -state $oldState -relief $oldRelief
  446.     uplevel #0 [list $w invoke]
  447.     }
  448. }
  449.  
  450. # tkCheckRadioInvoke --
  451. # The procedure below is invoked when the mouse button is pressed in
  452. # a checkbutton or radiobutton widget, or when the widget is invoked
  453. # through the keyboard.  It invokes the widget if it
  454. # isn't disabled.
  455. #
  456. # Arguments:
  457. # w -        The name of the widget.
  458. # cmd -        The subcommand to invoke (one of invoke, select, or deselect).
  459.  
  460. proc tkCheckRadioInvoke {w {cmd invoke}} {
  461.     if {[$w cget -state] != "disabled"} {
  462.     uplevel #0 [list $w $cmd]
  463.     }
  464. }
  465.  
  466.